home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / acad / autolisp / chg3 / chg3.lsp
Lisp/Scheme  |  1990-01-31  |  21KB  |  491 lines
  1. ;;; -*-  Mode: LISP -*-  (C) Ben Olasov 1988, 1989
  2. ;;; Entity edit function C:CHG  v. 2.6
  3. ;;; Displays and modifies properties of individual entities.
  4. ;;; 2.0 Revisions: Date: December 10, 1989
  5. ;;; ANSI menu added: January 23, 1990
  6. ;;; Color ANSI graphics added January 30, 1990
  7.  
  8. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  9. ;;; File: CHG.LSP     Copyright (C) Ben Olasov 1989                         ;;;
  10. ;;; Inquiries:                                                              ;;;
  11. ;;;                                                                         ;;;
  12. ;;;     Ben Olasov                                                          ;;;
  13. ;;;     Graphic Systems, Inc.:                                              ;;;
  14. ;;;                                                                         ;;;
  15. ;;;                    New York, NY:   PH (212) 725-4617                    ;;;
  16. ;;;                    MCI-Mail:       GSI-NY   344-4003                    ;;;
  17. ;;;                    Arpanet:        olasov@cs.columbia.edu               ;;;
  18. ;;;                                                                         ;;;
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20.  
  21. ;; This program is provided 'as is' without warranty of any kind, either 
  22. ;; expressed or implied, including, but not limited to the implied warranties of
  23. ;; merchantability and fitness for a particular purpose.  The entire risk as to
  24. ;; the quality and performance of the program is with the user.  Should the 
  25. ;; program prove defective, the user assumes the entire cost of all necessary 
  26. ;; servicing, repair or correction. 
  27. ;; AutoLisp and AutoCad are registered trademarks of AutoDesk, Inc.
  28.  
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  30. ;; CHG displays and modifies the properties of individual entities.          ;;
  31. ;;                                                                           ;;
  32. ;; CHG creates a numbered menu of the selected entities properties, and      ;;
  33. ;; then prompts the user to select the number of the property to modify.     ;;
  34. ;; CHG then prompts for a new value for that property, which may be a        ;;
  35. ;; point (list), real, integer, or string.                                   ;;
  36. ;;                                                                           ;;
  37. ;; Any changes made by CHG can be undone using AutoCad's 'U' command.        ;;
  38. ;; Doing so will return the drawing to its state before using CHG.           ;;
  39. ;;                                                                           ;;
  40. ;; A random example of using CHG:                                            ;;
  41. ;; In a drawing containing two valid blocks A and B, an individual           ;;
  42. ;; iteration of block A can be transformed to an iteration of block B by     ;;
  43. ;; giving B as its new name. All of its previous insertion parameters will   ;;
  44. ;; remain the same, but its identity will be changed to block B. If the      ;;
  45. ;; name of the layer in which the entity resides is changed to the name of   ;;
  46. ;; an existing layer, the entity will change its residence to that layer.    ;;
  47. ;; However, if the new layer name is the name of a non-existing layer, a     ;;
  48. ;; layer with that name will be created, and the entity will be transferred  ;;
  49. ;; to that layer.                                                            ;;
  50. ;;                                                                           ;;
  51. ;; Syntax: CHG                                                               ;;
  52. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  53.  
  54. (gc)
  55. (vmon)
  56. (graphscr)
  57. (princ "\nLoading- please wait..  ")
  58.  
  59. (defun descriptor (key e_type)
  60.        (cond ((null key) nil)
  61.              ((= key -1) "ENTITY NAME <RO>")
  62.              ((= key 0) "ENTITY TYPE")
  63.              ((= key 5) "HANDLE <RO>")
  64.              ((= key 6) "LINETYPE NAME <RO>")
  65.              ((= key 7) "TEXT STYLE NAME <RO>")
  66.              ((= key 8) "LAYER")
  67.              ((= key 9) "VARIABLE NAME IDENTIFIER")
  68.              ((and (>= key 10)
  69.                    (<= key 18)) (point_handler key ent))
  70.              ((= key 38) "ELEVATION")
  71.              ((= key 39) "THICKNESS")
  72.              ((and (>= key 1)
  73.                    (<= key 72)
  74.                    (or (= e_type "TEXT")
  75.                        (= e_type "ATTDEF"))) (text_handler key ent))
  76.              ((= key 1) "TEXT VALUE")
  77.              ((and (>= key 2)
  78.                    (<= key 71)
  79.                    (or (= e_type "BLOCK")
  80.                        (= e_type "INSERT"))) (block_handler key ent))
  81.              ((= key 2) "NAME")
  82.              ((or (= key 3)
  83.                   (= key 4)) "OTHER NAME VALUE")
  84.              ((= key 20) "PRIMARY Y COORDINATE")
  85.              ((and (>= key 21) (<= key 28)) "OTHER Y COORDINATE")
  86.              ((and (>= key 31) (<= key 36)) "OTHER Z COORDINATE")
  87.              ((and (>= key 40)
  88.                    (<= key 48)
  89.                    (or (= e_type "CIRCLE")
  90.                        (= e_type "ARC"))) "RADIUS")
  91.              ((and (>= key 40)
  92.                    (<= key 75)
  93.                    (= e_type "POLYLINE")) (pline_handler key ent))
  94.              ((and (>= key 40)
  95.                    (<= key 48)) "FLOATING POINT VALUE")
  96.              ((= key 49) "REPEATED VALUE")
  97.              ((and (>= key 50)
  98.                    (<= key 58)) "ANGLE")
  99.              ((= key 62) "COLOR #")
  100.              ((= key 66) "VERTICES FOLLOW <RO>")
  101.              ((and (= key 70)
  102.                    (= e_type "3DFACE")) (3dface_handler key ent))
  103.              ((= key 71) "MIRROR DIRECTION")
  104.              ((and (>= key 70) (<= key 78)) "INTEGER VALUE")
  105.              ((or (= key 210)
  106.                   (= key 220)
  107.                   (= key 230)) "EXTRUSION DIRECTION COORDINATES")
  108.              ((= key 999) "COMMENTS")
  109.              (T "UNCLASSIFIED VALUE")))
  110.  
  111. (princ "\rLoading- please wait... \\")
  112.  
  113. (defun format-input (key / val label)
  114.        (if (null key) nil
  115.            (progn (setq val (cdr (assoc key entity)))
  116.                   (graphscr)
  117.                   (cond ((= (type val) 'STR)
  118.                          (setq label (strcat (descriptor key etyp) ": "))
  119.                          (princ (strcat "\nCurrent " label))
  120.                          (princ val)
  121.                          (getstring T (strcat "\nNew " label)))
  122.                         ((= (type val) 'REAL)
  123.                          (cond ((and (>= key 40)
  124.                                      (<= key 48)
  125.                                 (or (= etyp "CIRCLE")
  126.                                     (= etyp "ARC")))
  127.                                 (setvar "coords" 2)
  128.                                 (princ "\nCurrent angle: ")
  129.                                 (princ val)
  130.                                 (getdist (cdr (assoc 10 entity)) "\nNew radius: "))
  131.                                ((and (>= key 50) (<= key 58))
  132.                                 (setvar "coords" 2)
  133.                                 (princ "\nCurrent angle: ")
  134.                                 (princ val)
  135.                                 (getangle (cdr (assoc 10 entity)) "\nNew angle: "))
  136.                               (T (setq label (strcat (descriptor key etyp) ": "))
  137.                                  (princ (strcat "\nCurrent " label))
  138.                                  (princ val)
  139.                                  (getreal (strcat "\nNew " label)))))
  140.                          ((= (type val)  'INT)
  141.                           (setq label (strcat (descriptor key etyp) ": "))
  142.                           (princ (strcat "\nCurrent " label))
  143.                           (princ val)
  144.                           (getint (strcat "\nNew " label)))
  145.                          ((= (type val) 'LIST)
  146.                           (setvar "coords" 2)
  147.                           (princ "\nCurrent point value: ")
  148.                           (princ val)
  149.                           (getpoint val "\nNew point: "))))))
  150.  
  151. (princ "\rLoading- please wait... \|")
  152.  
  153. (defun C:CHG (/ entity i ctr num tag new)
  154.        (if (setq ename (entsel))
  155.            (progn (setq ent (entget (car ename))
  156.                         entity (aux_remove (assoc 0 ent) ent)
  157.                         etyp (cdr (assoc 0 ent))
  158.                         header (strcat etyp " PROPERTY TABLE")
  159.                         num_props (length entity)
  160.                         i 0
  161.                         ctr 0)
  162.                   (setq items nil)
  163.                   (foreach e entity
  164.                            (setq items
  165.                                  (cons (strcat (descriptor (car e) etyp) 
  166.                                                "\:  " (stringify (cdr e))) items)))
  167.                   (setq num (menu-operation header
  168.                                             (reverse items)
  169.                                             "Number of property to change: "
  170.                                              (ran_color)))
  171.                   (if (and num
  172.                            (> num 0)
  173.                            (<= num num_props))
  174.                       (progn (setq tag (car (nth (1- num) entity))
  175.                                    new (format-input tag))
  176.                              (if new
  177.                                  (progn (setq ent (subst (cons tag new)
  178.                                                          (assoc tag entity) ent)
  179.                                               cmd (getvar "cmdecho"))
  180.                                         (setvar "cmdecho" 0)
  181.                                         (command "undo" "mark")
  182.                                         (setvar "cmdecho" cmd)
  183.                                         (entmod ent))
  184.                                   (princ "\Null input.")))
  185.                       (princ "\nInvalid number.")))
  186.            (princ "\nNo entity selected."))
  187.        (princ))
  188.  
  189. (princ "\rLoading- please wait... \/")
  190.  
  191. (defun text_handler (key elist)
  192.        (setq bit_code (cdr (assoc key elist)))
  193.        (cond ((= key 1) "TEXT VAL")
  194.              ((= key 2) "ATTRIBUTE TAG")
  195.              ((= key 40) "TEXT HGT")
  196.              ((= key 41) "RELATIVE X SCL FACTOR")
  197.              ((= key 50) "ROTATION ANG")
  198.              ((= key 51) "OBLIQUING ANG")
  199.              ((= key 70)
  200.               (strcat "ATTRIBUTE "
  201.                       (cond ((= bit_code 1) "<INVISIBLE>")
  202.                             ((= bit_code 2) "<CONSTANT>")
  203.                             ((= bit_code 4) "<VERIFICATION REQD>")
  204.                             ((= bit_code 8) "<PRESET>")
  205.                             (T "<UNKNOWN BIT CODE>"))))
  206.              ((= key 71)
  207.               (strcat "TEXT GENERATION "
  208.                       (cond ((= bit_code 0) "")
  209.                             ((= bit_code 2) "<BACKWARDS>")
  210.                             ((= bit_code 4) "<UPSIDE DOWN>")
  211.                             (T "<UNKNOWN BIT CODE>"))))
  212.              ((= key 72)
  213.               (strcat "TEXT JUSTIFICATION "
  214.                       (cond ((= bit_code 0) "<LEFT JUSTIFIED>")
  215.                             ((= bit_code 1) "<CENTERED ALONG BASELINE>")
  216.                             ((= bit_code 2) "<RIGHT JUSTIFIED>")
  217.                             ((= bit_code 3) "<ALIGNED BTWN 2 POINTS>")
  218.                             ((= bit_code 4) "<MIDDLE CENTERED>")
  219.                             ((= bit_code 5) "<FIT BETWEEN 2 POINTS>")
  220.                             (T "<UNKNOWN CODE>"))))
  221.             (T "UNKNOWN FLAG")))
  222.  
  223. (princ "\rLoading- please wait... \-")
  224.  
  225. (defun pline_handler (key elist)
  226.        (setq bit_code (cdr (assoc key elist)))
  227.        (cond ((= key 40) "STARTING WIDTH")
  228.              ((= key 41) "ENDING WIDTH")
  229.              ((= key 66) "VERTICES FOLLOW <RO>")
  230.              ((= key 70)
  231.               (strcat "POLYLINE "
  232.                       (cond ((= bit_code 1)  "<CLOSED>")
  233.                             ((= bit_code 2)  "<CURVE-FIT VERTICES ADDED>")
  234.                             ((= bit_code 4)  "<SPLINE-FIT VERTICES ADDED>")
  235.                             ((= bit_code 8)  "<3D POLYLINE>")
  236.                             ((= bit_code 16) "<3D MESH>")
  237.                             ((= bit_code 32) "<3D MESH CLOSED IN N DIRECTION>")
  238.                             (T "<UNKNOWN BIT CODE>"))))
  239.              ((or (= key 71)
  240.                   (= key 72)) (strcat "POLYGON MESH "
  241.                                       (if (= key 71) "M" "N")
  242.                                      " COUNT"))
  243.              ((or (= key 73)
  244.                   (= key 74)) (strcat "POLYGON MESH "
  245.                                       (if (= key 73) "M" "N")
  246.                                       " DENSITY"))
  247.              ((= key 75)
  248.               (strcat "SMOOTH SURFACE TYPE "
  249.                       (cond ((= bit_code 0)  "<NO SMOOTH SURFACE FITTED>")
  250.                             ((= bit_code 5)  "<QUADRATIC B-SPLINE>")
  251.                             ((= bit_code 6)  "<CUBIC B-SPLINE>")
  252.                             ((= bit_code 8)  "<BEZIER SURFACE>")
  253.                             (T "<UNKNOWN BIT CODE>"))))
  254.              (T "UNKNOWN POLYLINE FLAG")))
  255.  
  256. (princ "\rLoading- please wait... \\")
  257.  
  258. (defun 3dface_handler (key elist)
  259.        (setq bit_code (cdr (assoc key elist)))
  260.        (cond ((= key 70)
  261.               (strcat "INVISIBLE EDGE FLAG "
  262.                       (cond ((= bit_code 0)  "<NO")
  263.                             ((= bit_code 1)  "<1ST")
  264.                             ((= bit_code 2)  "<2ND")
  265.                             ((= bit_code 4)  "<3RD")
  266.                             ((= bit_code 8)  "<4TH")
  267.                             (T "UNIDENTIFIED"))
  268.                       " EDGE INVISIBLE>"))))
  269.  
  270. (princ "\rLoading- please wait... \|")
  271.  
  272. (defun block_handler (key elist)
  273.        (setq bit_code (cdr (assoc key elist)))
  274.        (cond ((= key 2) "BLOCK NAME")
  275.              ((= key 41) "X SCALE FACTOR")
  276.              ((= key 42) "Y SCALE FACTOR")
  277.              ((= key 43) "Z SCALE FACTOR")
  278.              ((= key 44) "COLUMN SPACING")
  279.              ((= key 45) "ROW SPACING")
  280.              ((= key 50) "ROTATION ANG")
  281.              ((= key 66) "ATTRIBUTES FOLLOW <RO>")
  282.              ((and (= key 70)
  283.                    (= etyp "BLOCK"))
  284.               (strcat "BLOCK TYPE"
  285.                       (cond ((= bit_code 1) "ANONYMOUS")
  286.                             ((= bit_code 2) "ATTRIBUTES")
  287.                             (T "UNKNOWN BIT CODE"))))
  288.  
  289.              ((= key 70) "COLUMN COUNT")
  290.              ((= key 71) "ROW COUNT")
  291.              (T "UNCLASSIFIED VALUE")))
  292.  
  293. (princ "\rLoading- please wait... \/")
  294.  
  295. (defun point_handler (key elist)
  296.        (setq bit_code (cdr (assoc key elist)))
  297.        (cond ((= key 10) "ORIGIN PT")
  298.              ((and (= key 11)
  299.                    (or (= etyp "LINE")
  300.                        (= etyp "TEXT"))) "END PT")
  301.              ((= key 11) "2ND PT")
  302.              ((= key 12) "3RD PT")
  303.              ((= key 13) "4TH PT")
  304.              ((and (>= key 14)
  305.                    (<= key 18)) "OTHER POINT COORDINATE")))
  306.  
  307. (princ "\rLoading- please wait... \-")
  308.  
  309. (defun aux_remove (atm lst) 
  310.        (cond ((null lst) nil) 
  311.              ((null (member atm lst)) lst)
  312.              ((equal atm (car lst)) (cdr lst))
  313.              (t (append (reverse (cdr (member atm (reverse lst))))
  314.                         (cdr (member atm lst))))))
  315.  
  316.  
  317. (princ "\rLoading- please wait... \\")
  318.  
  319. (defun stringify (exp)
  320.        (cond ((null exp) "nil")
  321.              ((= (type exp) 'STR) exp)
  322.              ((= (type exp) 'ENAME) "")
  323.              ((= (type exp) 'INT) (itoa exp))
  324.              ((= (type exp) 'REAL) (rtos exp 2 6))
  325.              ((= (type exp) 'LIST)
  326.               (strcat "\(" (rtos (car exp) 2 4)
  327.                            (if (cadr exp) (strcat " "(rtos (cadr exp) 2 4)) "")
  328.                            (if (caddr exp) (strcat " " (rtos (caddr exp) 2 4)) "")
  329.                        "\)"))
  330.              (T "")))
  331.  
  332. (princ "\rLoading- please wait... \\") 
  333.  
  334. (DEFUN MENU-OPERATION (HEADER ITEM-LIST PRMPT COLOR / HGT WDT I L-COL)
  335.        (MENU_INIT COLOR)
  336.        (PAINT_BKGRND TOP_MARG L_COL HGT WDT COLOR)
  337.        (PAINT_FRAME TOP_MARG L_COL HGT WDT)
  338.        (PRINT_HEADER TOP_MARG L_COL WDT)
  339.        (PRINT_ITEMS ITEM-LIST TOP_MARG L_COL COLOR)
  340.        (PRINT_PRMPT PRMPT TOP_MARG L_COL HGT)
  341.        (USR_VAL))
  342.  
  343. (princ "\rLoading- please wait... \|") 
  344.  
  345. (DEFUN MENU_INIT (COLOR)
  346.        (TEXTSCR)
  347.        (CLS)
  348.        (NORMAL)
  349.        (PRINC (STRCAT "\e[" (ITOA COLOR) "m"))
  350.        (IF (/= (REM (STRLEN HEADER) 2) 0) (SETQ HEADER (STRCAT HEADER " ")))
  351.        (SETQ HGT (+ 5 (LENGTH ITEM-LIST))
  352.              WDT (+ 10 (MAX (LONGEST ITEM-LIST) (STRLEN HEADER))))
  353.        (IF (/= (REM HGT 2) 0) (SETQ HGT (1+ HGT)))
  354.        (IF (/= (REM WDT 2) 0) (SETQ WDT (1+ WDT)))
  355.        (SETQ L_COL (- 40 (/ WDT 2))
  356.              i 0
  357.              TOP_MARG (- 12 (/ HGT 2))))
  358.  
  359. (princ "\rLoading- please wait... \/") 
  360.  
  361. (DEFUN PAINT_BKGRND (RW CL HT WD COLOR)
  362.        (IF (> COLOR 40)  ;;don't try to paint invisible backgrounds
  363.            (PROGN (GOTO (1+ RW) (1+ CL))
  364.                   (REPEAT (- HT 1)
  365.                           (REPEAT (- WD 2) (PRINC " " ))
  366.                                   (NEXTROW (- WD 2))))))
  367.  
  368. (princ "\rLoading- please wait... \-") 
  369.  
  370. (DEFUN PAINT_FRAME (RW CL HT WD)
  371.        (GOTO RW CL)           ;; position cursor at top left corner of frame 
  372.        (PRINC (CHR 201))      ;; paint top left corner of frame
  373.        (REPEAT (- WD 2)       ;; paint top of frame
  374.                (PRINC (CHR 205)))
  375.        (PRINC (CHR 187))      ;; paint top right corner of frame
  376.        (REPEAT 3
  377.                (NEXTROW WD)
  378.                (PRINC (CHR 186))      ;; print side-of-frame char
  379.                (MOVE (- WD 2) "C")    ;; move to right side of frame
  380.                (PRINC (CHR 186)))     ;; print side-of-frame char
  381.        (NEXTROW WD)
  382.        (PRINC (CHR 204))                     ;;paint middle bar
  383.        (REPEAT (- WDT 2) (PRINC (CHR 205)))
  384.        (PRINC (CHR 185))
  385.        (REPEAT (- HT 5)
  386.                (NEXTROW WD)
  387.                (PRINC (CHR 186))      ;; print side-of-frame char
  388.                (MOVE (- WD 2) "C")    ;; move to right side of frame
  389.                (PRINC (CHR 186)))     ;; print side-of-frame char
  390.        (NEXTROW WD)
  391.        (PRINC (CHR 200))
  392.        (REPEAT (- WDT 2) (PRINC (CHR 205)))
  393.        (PRINC (CHR 188)))
  394.  
  395. (princ "\rLoading- please wait... \\") 
  396.  
  397. (DEFUN PRINT_HEADER (RW CL WD)
  398.        (GOTO (+ RW 3)
  399.              (+ CL (- (/ WD 2) (/ (STRLEN HEADER) 2))))
  400.        (BOLD)
  401.        (PRINC HEADER)
  402.        (NORMAL))
  403.  
  404. (DEFUN PRINT_HEADER (RW CL WD)
  405.        (GOTO (+ RW 2)
  406.              (+ CL (- (/ WD 2) (/ (STRLEN HEADER) 2))))
  407.        (BOLD)
  408.        (PRINC HEADER))
  409.  
  410. (princ "\rLoading- please wait... \|") 
  411.  
  412. (DEFUN PRINT_ITEMS (ITM_LST RW CL COLOR)
  413.        (PRINC (STRCAT "\e[0m\e[" (ITOA COLOR) "m")) ;;restore normal screen
  414.        (SETQ I 0)                                   ;;& then init user color
  415.        (FOREACH ITEM ITM_LST
  416.                 (SETQ I (1+ I))
  417.                 (GOTO (+ RW 4)
  418.                       (+ CL 2))
  419.                 (MOVE I "B")     ;; move I spaces down
  420.                 (PRINC (STRCAT " "
  421.                                (IF (< I 10) " " "")
  422.                                (RTOS (FLOAT I) 2 0) "] " ITEM))))
  423.  
  424. (princ "\rLoading- please wait... \/") 
  425.  
  426. (DEFUN PRINT_PRMPT (PRMPT RW CL HT)
  427.        (NORMAL)
  428.        (GOTO (+ RW HT 3) 0)
  429.        (PRINC PRMPT)
  430.        (GC))
  431.  
  432. (princ "\rLoading- please wait... \-") 
  433.  
  434. (DEFUN USR_VAL ()
  435.        (NORMAL)
  436.        (SETQ CHOICE (GETINT))
  437.        (WHILE (OR (< CHOICE 1) (> CHOICE (LENGTH ITEM-LIST)))
  438.               (SETQ CHOICE (GETINT "Choice is out of range, try again: ")))
  439.        (CLS) CHOICE)
  440.  
  441. ;;length of longest string in a list of strings
  442. (princ "\rLoading- please wait... \\") 
  443.  
  444. (DEFUN LONGEST (LST)
  445.        (APPLY 'MAX (MAPCAR '(LAMBDA (ITM) (STRLEN ITM)) LST)))
  446.  
  447. (princ "\rLoading- please wait... \|") 
  448.  
  449. (DEFUN BOLD ()
  450.        (PRINC "\e[1m"))
  451.  
  452. (princ "\rLoading- please wait... \/") 
  453.  
  454. (DEFUN NORMAL ()
  455.        (PRINC "\e[0m"))
  456.  
  457. (DEFUN RVRS ()
  458.        (PRINC "\e[7m"))
  459.  
  460. (princ "\rLoading- please wait... \-")
  461.  
  462. (defun MOVE (NO DIR) ;;DIR ARG: A=UP   B=DOWN   C=RIGHT   D=LEFT
  463.        (princ (strcat "\e[" (itoa NO) DIR)))
  464.  
  465. (princ "\rLoading- please wait... \/") 
  466.  
  467. (defun CLS () (textscr)
  468.        (princ "\e[2J"))
  469.  
  470. (princ "\rLoading- please wait... \-") 
  471.  
  472. (defun goto (ROW COL)
  473.        (princ (strcat "\e[" (itoa row) "\;" (itoa col) "H")))
  474.  
  475. (princ "\rLoading- please wait... \\") 
  476.  
  477. (defun nextrow (cols)
  478.        (princ (strcat "\e[" (itoa cols) "D" "\e[1B")))
  479.  
  480. (defun ran_color (/ *s)
  481.        (setq s (if s (rem (+ (* s 15625.7) 0.21137152) 1)
  482.                       0.3171943)
  483.              s (* 50 s))
  484.        (cond ((< s 31) (setq *s (fix (max 31 (/ (+ s 46) 2)))))
  485.              ((> s 46) (setq *s (fix (min 46 (/ (+ s 31) 2)))))
  486.              (T (setq *s (fix s)))))
  487.  
  488. (princ "\rCommand level function C:CHG loaded.  Type CHG to begin.")
  489. (princ)
  490.  
  491.